perm filename CLFZ.F4[MSS,LCS]4 blob sn#100943 filedate 1974-05-04 generic text, type T, neo UTF8
00010	C****  CLEFS, JDRAW, CENTR, LINX *********
00100		SUBROUTINE CLEFS
00200		IMPLICIT INTEGER(A-Q,S-Z)
00300		DIMENSION JCLEF(10),MCLEF(600),RCMIN(4)
00400		REAL DIS,PWDS,DISX,CENTR,POS,STF
00500		COMMON /STF/RSTFAC(8),RSTJC
00600		COMMON RJB,JA,CENTR,JB,RJQ(20),JQ(20)
00700		COMMON/PLTR/PLT,RHT,DIS
00800	      DATA RCMIN/3.3,10.5,7.0,10.5/,JFX/-1/,NAME/0/
00900		EQUIVALENCE (JD,JQ(2)),(RJD,RJQ(2)),(JE,JQ(3)),(JI,JQ(7))
01000	     1 ,(RJF,RJQ(4)),(RJE,RJQ(3)),(JH,JQ(6)),(RJG,RJQ(5)),(JJ,JQ(8))
01050		1,(RJI,RJQ(7))
01100		NM='CLFX'
01200		JE=MOD(JE,100)
01300		JEZ=JE
01400		IF(JA.EQ.3)GO TO 2
01405	C  YOU MUST TYPE "DRAW" NAME 1ST TIME.  IT'S STICKY.
01410		IF(NAME.NE.0.AND.JJ.EQ.0)GO TO 4
01420		TYPE 5
01430		ACCEPT 6,NAME
01440	5	FORMAT(' "DRAW" NAME -- '$)
01445	6	FORMAT(A5)
01450	4	KA=JE/10
01475	C KA LEADS TO PROPER FILE CALL
01550		NM=NAME+2*KA
01575	C  DRAW0 HAS ITEMS 0→9;  DRAW1, 10→19; ETC. TO DRAW9, 90→99
01800		JEZ=MOD(JE,10)+1
01900	2	IF(NM.EQ.JNM)GO TO 30
01950	C  SET P10≠0 TO CHANGE BASIC 'DRAW' NAME.
02000	C  JUMP IF ALREADY IN CORE
02010		IF(LOOKD(NM))GO TO 1111
02032		TYPE 1112,NM
02054		RETURN
02076	1112	FORMAT(1XA5,' -- NOT FOUND')
02100	1111	JNM=NM
02200		CALL RDDATA(NM,JCLEF,MCLEF)
02300	CC30	CENTR=POS+2*RSTJC+RJD*RSTJC*7
02400	30	CALL CENTER(CENTR)
02500	C   CHECK THE ABOVE  -- FOR P5 HEIGHT CHANGE *********************
02600		IF(RJF.EQ.0)RJF=1
02700		IF(RJG.EQ.0)RJG=1
02800	C  RJF IS SIZE FACTOR
02900		IF(JE.GT.4.OR.JA.NE.3)GO TO 811
02910		IF(JEZ.EQ.0)JEZ=1
03000		IF(RJE.LT.100)GO TO 812
03100		RSTJC=.8*RSTJC
03200		CENTR=CENTR+RCMIN(JEZ)*RSTJC
03300	C  TO SET HGT. OF MINI CLEFS
03400	812	IF(JEZ.NE.4)GO TO 811
03500		CENTR=CENTR+RSTJC*14
03600		JEZ=3
03700	C   ABOVE IS NOW AT TOP
03800	811	L=JCLEF(JEZ)
03850		IF(JI.NE.0)CALL ROTATE(MCLEF,L,RJI)
03875	C  RJI=P9=DEGREES OF ROTATION (0-360)
03900		CALL JDRAW(MCLEF(L),RJB,CENTR,RSTJC,RJF,RJG)
04000	C   3,POS.,STF,NT# OR CLEF,ITEM#,SIZEX,SIZEY, JH=-1 TO FILL ON CRT
04100	C			JH=-2 OMITS FILLER DURING PLOT
04200	
04300		N=0
04400		JD=MCLEF(L)+L
04500		IF(MCLEF(JD).EQ.999)N=JD+1
04600	1	IF(N.NE.0.AND.JH.NE.-2.AND.(PLT.OR.JH))CALL OLDFIL(MCLEF(N),
04700		1 RJB,CENTR,RJF,RJG)
04710		IF((JH.EQ.-2.AND.PLT).OR.(JH.NE.-1.AND.PLT.GE.0))GO TO 7
04720		DO 3 K=L+1,MCLEF(L)+L
04730		IF(MCLEF(K).LT.200000000)GO TO 3
04732		JD=MCLEF(L)-1
04735		IF(K.GT.L+1)JD=JD-K+L+1
04740		CALL FILLMS(JD,MCLEF(K),RJB,CENTR,RJF,RJG)
04750		GO TO 7
04760	3	CONTINUE
04770	CC7	IF(JI.NE.0)CALL UNROT(MCLEF(L))
04800	C  FILLS ONLY WHEN PLOTING OR RJG=-1
04900	7	END
05000	
05100		SUBROUTINE JDRAW(M,RJB,CENTR,RSTJC,RX,RY)
05200		COMMON/LL/LL
05300		DIMENSION M(1)
05400		RC=RX*RSTJC
05500		RD=RY*RSTJC
05600		DO 2 K=2,M(1)
05700		CALL UNPACK(IA,IB,M(K))
05800	CC	RA=IA*RC+RJB
05900	CC	RB=IB*RD+CENTR
06000	CC	IF(K.EQ.I)LL=3
06100	CC2	CALL LINES(RA,RB,LL)
06200	2	CALL LINES(FLOAT(IA)*RC+RJB,FLOAT(IB)*RD+CENTR,LL)
06300		END
06400	
06500		SUBROUTINE CENTER(CNTR)
06600	C  TO CENTER ITEMS CREATED WITH DRAWING PROG.
06700		COMMON /STF/RSTFAC(8),RSTJC
06800		COMMON RJB,JA,CENTR,JB,RJQ(20),JQ(20)
06900		COMMON/POSI/STF(8),JJB,POS
07000		EQUIVALENCE (RJD,RJQ(2))
07100		CNTR=POS+2+AMOD(RJD,100.)*RSTJC*7
07200		END
07300	
30000		SUBROUTINE LINX(A,B,C,D)
30100	C  SAVES SPACE FOR SINGLE LINES.
30200		CALL LINES(A,B,3)
30300		CALL LINES(C,D,2)
30400		END